home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 2: CDPD 1 / Almathera Ten on Ten - Disc 2: CDPD 1.iso / pd / 051-075 / 071 / amibas / search (.txt) < prev    next >
AmigaBASIC Source Code  |  1995-03-13  |  4KB  |  136 lines
  1. ' Search a file for a given string.
  2. ' Difference to AmigaDOS command SEARCH:
  3. ' string may contain control chars,
  4. ' a binary file can be searched. 
  5. ' P. Kittel, CBM Ffm, Start 6.1.87, 24.2.87
  6.  
  7. vl=10:nl=10 ' default pre-run, past-run
  8.  
  9. Start:
  10. CLS
  11. PRINT "Search  - Search a File for a Given String
  12. PRINT 
  13. PRINT "Include in quotes when giving a whole path description:
  14. PRINT"File name ";f$;:INPUT" = ";ff$
  15. IF ff$<>"" THEN f$=ff$
  16. IF f$ = "" THEN RUN
  17.  
  18. PRINT :PRINT "Type string to be searched for:
  19. PRINT "include normal text in quotes,
  20. PRINT "enter other single chars as decimal codes or
  21. PRINT "as a hex code preceded by a dollar sign,
  22. PRINT "mark end of string by a simple e :
  23.  
  24. s$="":se$=""
  25. WHILE se$<>"e"    '" one char or string fraction per time
  26.   LINE INPUT se$
  27.   WHILE LEFT$(se$,1)=" ":se$=MID$(se$,2):WEND            ' cancel leading and
  28.   WHILE RIGHT$(se$,1)=" ":se$=LEFT$(se$,LEN(se$)-1):WEND ' following spaces
  29.   
  30.   IF LEFT$(se$,1)=CHR$(34) THEN ' quotes mark normal string
  31.     se$=MID$(se$,2)
  32.     IF RIGHT$(se$,1)=CHR$(34) THEN se$=LEFT$(se$,LEN(se$)-1)
  33.     s$=s$+se$:se$=""
  34.     
  35.     ELSEIF LEFT$(se$,1)="$" THEN ' Dollar marks input in hex
  36.     s=0
  37.     IF LEN(se$)>1 THEN
  38.       FOR i=2 TO LEN(se$)                ' hex to dec conversion
  39.         si=ASC(UCASE$(MID$(se$,i,1)))-48
  40.         IF si>9 THEN si=si-7
  41.         IF si<0 OR si>15 THEN PRINT :PRINT "Unexpected char ";MID$(se$,i,1);" !":PRINT :END
  42.         s=16*s+si
  43.         NEXT
  44.       END IF
  45.     IF s<0 OR s>255 THEN PRINT :PRINT "Impossible code value!":END
  46.     s$=s$+CHR$(s)
  47.     
  48.     ELSEIF se$<>"e" THEN ' remains only:
  49.     s=VAL(se$)           '               code in dec 
  50.     IF s<0 OR s>255 THEN PRINT :PRINT "Impossible code value!":END
  51.     s$=s$+CHR$(s)
  52.     
  53.     END IF
  54.   WEND
  55.  
  56. ' search string length delimited to 100 bytes (randomly chosen value)
  57. IF LEN(s$)>100 THEN PRINT :PRINT "Search string too long!":END
  58. l=LEN(s$):IF l<100 THEN l=100
  59. n=0:a$="":ls=LEN(s$)
  60.  
  61. PRINT :PRINT "Pre-run and past-run mean count of bytes to show maximally 
  62. PRINT "before and after an actual occurence of search string in the file: 
  63. PRINT :PRINT "Pre-run  maximal in bytes ";vl;:INPUT" = ";a$
  64. IF a$<>"" THEN vl=VAL(a$)
  65. PRINT :PRINT "Past-run maximal in bytes ";nl;:INPUT" = ";a$
  66. IF a$<>"" THEN nl=VAL(a$)
  67. PRINT
  68.  
  69. PRINT "Abort search with q key, pause with any.":PRINT 
  70.  
  71. OPEN f$ FOR INPUT AS 1:lo=LOF(1):PRINT "File length:";lo;"bytes":PRINT 
  72. WHILE (NOT EOF(1)) AND l>0   ' loop for whole file
  73.   aa$=a$:ii=LEN(a$)
  74.   IF n+ii+l>lo THEN l=lo-n-ii
  75.   a$=INPUT$(l,1)             ' read
  76.   
  77.   Abfrage:
  78.   g$=INKEY$                  ' key pressed?
  79.   IF g$<>"" THEN
  80.     IF g$<>"q" THEN g$="":WHILE g$="":g$=INKEY$:WEND ' wait for another key
  81.     IF g$="q" THEN l=0:a$="" ' abort with q key
  82.     END IF
  83.   is=INSTR(aa$+a$,s$) ' always consider new (a$) and last (aa$) fraction together
  84.   IF is>0 THEN  
  85.     ii=0:nn=n   ' search string found
  86.     ab$=aa$+a$   
  87.     ' omit bytes until pre-run:
  88.     IF is>vl THEN ab$=MID$(ab$,is-vl):nn=nn+is-vl-1:n=n+is-vl-1:is=is-is+vl+1
  89.     ad$=ab$
  90.     ' omit bytes after past-run:
  91.     IF is+ls+nl<LEN(ab$) THEN ab$=LEFT$(ab$,is+ls+nl)
  92.     lb=LEN(ab$):ac$=""
  93.     PRINT 
  94.     FOR i=1 TO LEN(ab$) ' loop for region to be shown
  95.       IF ac$="" THEN PRINT RIGHT$("000"+HEX$(nn),4);"  "; ' address in file in hex
  96.       ii=ii+1
  97.       a=ASC(MID$(ab$,i,1))
  98.       IF i>=is AND i<is+ls THEN COLOR 3 ' mark search string by color
  99.       PRINT RIGHT$("0"+HEX$(a),2);" ";  ' single hexbyte
  100.       COLOR 1
  101.       ac$=ac$+CHR$(a)
  102.       IF ii=16 OR i=lb THEN  ' show as normal chars on the right
  103.         PRINT "  ";:IF i=lb THEN PRINT SPC(3*(16-ii));
  104.         IF ac$<>"" THEN
  105.           FOR ij=1 TO LEN(ac$)
  106.             a=ASC(MID$(ac$,ij,1))
  107.             ' mark control chars by color:
  108.             IF a<32 THEN COLOR 2:PRINT CHR$(a+64);:COLOR 1 :ELSE PRINT CHR$(a);
  109.             NEXT
  110.           END IF
  111.         ac$="":nn=nn+ii:ii=0
  112.         PRINT 
  113.         END IF
  114.       g$=INKEY$       ' key pressed?
  115.       IF g$<>"" THEN
  116.         IF g$<>"q" THEN g$="":WHILE g$="":g$=INKEY$:WEND ' wait for another key
  117.         IF g$="q" THEN i=1e+09 ' abort with q key
  118.         END IF
  119.       NEXT
  120.     ' search string in this fraction another time?
  121.     IF is+ls<LEN(ad$)-ls THEN aa$="":a$=MID$(ad$,is+1):n=n+is:GOTO Abfrage
  122.     a$=ad$  ' actualize a$ (actual fraction of file)
  123.             ELSE
  124.     ii=LEN(aa$+a$):IF ii>l THEN a$=RIGHT$(aa$+a$,l):n=n+ii-l
  125.     END IF
  126.   WEND
  127.   
  128. CLOSE 1
  129.  
  130. PRINT :PRINT "Continue with any key, abort with q ."
  131. a$="":WHILE a$="":a$=INKEY$:WEND
  132.  
  133. IF a$<>"q" THEN Start
  134. END
  135.  
  136.